home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / tpseek.arc / SEEKTEST.PAS < prev   
Pascal/Delphi Source File  |  1991-04-28  |  12KB  |  261 lines
  1. program seektest;
  2. {----------------------------------------------------------------------------
  3.  |  Program SEEKTEST.PAS                                                    |
  4.  |                                                                          |
  5.  |  This program demonstrates the use of TPHRT in timing seek performance   |
  6.  |  of a PC based hard disk drive.  The method used will determine the total|
  7.  |  seek time of the device which includes actual disk seek, controller     |
  8.  |  overhead, and ROM BIOS overhead.  This is a "real world" measurement    |
  9.  |  of disk performance under actual usage conditions.                      |
  10.  |                                                                          |
  11.  |  Environment: Turbo Pascal 5.0                                           |
  12.  |                                                                          |
  13.  |  (c)1989 Ryle Design, P.O. Box 22, Mt. Pleasant, Michigan 48804          |
  14.  ----------------------------------------------------------------------------}
  15. uses
  16.     dos, crt, tphrt;
  17.  
  18. var
  19.     regs    : registers;
  20.     indx    : integer;
  21.     numdisk : integer;
  22.     atom    : byte;
  23.     keyin   : char;
  24.  
  25.  
  26. procedure disk_err(istat : integer);
  27. {----------------------------------------------------------------------------
  28.  |  This procedure outputs a description of an INT $13 error status, and    |
  29.  |  halts program execution.                                                |
  30.  |                                                                          |
  31.  |  Globals referenced: none                                                |
  32.  |                                                                          |
  33.  |  Arguments: (integer) istat - status returned from INT $13 in AH if      |
  34.  |                               carry flag set.                            |
  35.  |                                                                          |
  36.  |  Returns  : void                                                         |
  37.  ----------------------------------------------------------------------------}
  38. begin
  39.     if (istat <> 0) then
  40.     begin
  41.         case istat of
  42.             $01 : writeln('Disk error: Invalid command');
  43.             $02 : writeln('Disk error: Address mark not found');
  44.             $03 : writeln('Disk error: Disk is write-protected');
  45.             $04 : writeln('Disk error: Requested sector not found');
  46.             $05 : writeln('Disk error: Reset failed');
  47.             $06 : writeln('Disk error: Floppy disk removed');
  48.             $07 : writeln('Disk error: Bad parameter table');
  49.             $08 : writeln('Disk error: DMA overrun');
  50.             $09 : writeln('Disk error: DMA crossed 64KB boundary');
  51.             $0A : writeln('Disk error: Bad sector flag set');
  52.             $0B : writeln('Disk error: Bad track flag set');
  53.             $0C : writeln('Disk error: Requested media type not found');
  54.             $0D : writeln('Disk error: Invalid number of sectors on format');
  55.             $0E : writeln('Disk error: Control data address mark detected');
  56.             $0F : writeln('Disk error: DMA arbitration level out of range');
  57.             $10 : writeln('Disk error: Uncorrectable CRC or ECC data error');
  58.             $11 : writeln('Disk warning: ECC corrected data error');
  59.             $20 : writeln('Disk error: Controller failed');
  60.             $40 : writeln('Disk error: Seek failed');
  61.             $80 : writeln('Disk error: Disk has timed out');
  62.             $AA : writeln('Disk error: Drive not ready');
  63.             $BB : writeln('Disk error: Error is undefined');
  64.             $CC : writeln('Disk error: Write fault');
  65.             $E0 : writeln('Disk error: Status register error');
  66.             $FF : writeln('Disk error: Sense operation failed');
  67.         else
  68.             writeln('Unknown INT 13 return status ',istat);
  69.         end;
  70.  
  71.         halt;
  72.     end;
  73. end; { disk_err }
  74.  
  75.  
  76. procedure test_disk(disk : byte);
  77. {----------------------------------------------------------------------------
  78.  |  This procedure, which contains the actual disk test routines, does the  |
  79.  |  following:                                                              |
  80.  |      1. Seeks the test disk to track 0.                                  |
  81.  |      2. Times 100 calls to seek to track 0.  Since the heads are already |
  82.  |         on track 0, they will not move, and a estimate of the software   |
  83.  |         overhead for each seek call can be made.                         |
  84.  |      3. Times single track seeks to all cylinders (0-1,1-2,2-3,3-4,etc). |
  85.  |         This provides a measurement of single track seek time.           |
  86.  |      4. Seeks from track 0 to all tracks (0-1,0-2,0-3,0-4,etc).  This    |
  87.  |         provides average seek time for the entire disk.                  |
  88.  |      5. The results are reported.                                        |
  89.  |                                                                          |
  90.  |  TP intr() is used to call the ROM BIOS.  There is some software         |
  91.  |  overhead incurred using this method.                                    |
  92.  |                                                                          |
  93.  |  Globals referenced: regs                                                |
  94.  |                                                                          |
  95.  |  Arguments: (char) disk - physical disk # - add to $80 for BIOS call.    |
  96.  |                                                                          |
  97.  |  Returns  : void                                                         |
  98.  ----------------------------------------------------------------------------}
  99. var
  100.     maxhead,maxcyl,indx                     : integer;
  101.     seek1,seek2,seek3,hits1,hits2,hits3     : longint;
  102.  
  103. begin
  104.  
  105.     regs.dl := $80 + disk;                                  { get disk config }
  106.     regs.ah := $08;
  107.     intr($13,regs);
  108.     if ( (regs.flags and Fcarry) <> 0) then disk_err(regs.ah);
  109.  
  110.     maxhead := regs.dh;                                     { move bits to get }
  111.     maxcyl := ((regs.cl and $C0) shl 2) + regs.ch;          { heads & tracks   }
  112.  
  113.     writeln;
  114.     writeln('Physical drive ',disk,' shows ',maxcyl+1,' cylinders, ',maxhead+1,' heads');
  115.     writeln;
  116.  
  117.     writeln('Starting track to track seek test ...');
  118.  
  119.     regs.ah := $0C;                                         { seek command                        }
  120.     regs.ch := $00;                                         { track 0                             }
  121.     regs.cl := $01;                                         { XTs need sector bit set, or no seek }
  122.     regs.dh := 0;                                           { head 0                              }
  123.     regs.dl := $80 + disk;                                  { disk #                              }
  124.  
  125.     intr($13,regs);                                         { seek to track 0 }
  126.     if ( (regs.flags and Fcarry) <> 0) then disk_err(regs.ah);
  127.  
  128.     for indx := 1 to 100 do                                 { seek to 0 100 times to get ave overhead }
  129.     begin
  130.         regs.ah := $0C;                                     { seek command                        }
  131.         regs.ch := $00;                                     { track 0                             }
  132.         regs.cl := $01;                                     { XTs need sector bit set, or no seek }
  133.         regs.dh := 0;                                       { head 0                              }
  134.         regs.dl := $80 + disk;                              { disk #                              }
  135.  
  136.         t_entry(3);
  137.         intr($13,regs);
  138.         t_exit(3);
  139.     end;
  140.  
  141.     for indx := 1 to maxcyl do                              { from zero, single track seek to end of disk }
  142.     begin
  143.         regs.ah := $0C;                                     { seek command                         }
  144.         regs.ch := indx and $00FF;                          { mask track bits and stuff in cl & ch }
  145.         regs.cl := ((indx and $0300) shr 2) + 1;            { cl sector bit 1 for XTs              }
  146.         regs.dh := 0;                                       { head 0                               }
  147.         regs.dl := $80 + disk;                              { disk #                               }
  148.  
  149.         t_entry(1);
  150.         intr($13,regs);                                     { seek }
  151.         t_exit(1);
  152.  
  153.         if ( (regs.flags and Fcarry) <> 0) then disk_err(regs.ah);
  154.     
  155.         if ((indx mod 100) = 0) then write(indx,' ');       { echo to user our progress }
  156.     end;
  157.  
  158.     writeln;
  159.     writeln;
  160.     writeln('Starting full disk seek test ...');
  161.  
  162.     regs.ah := $0C;
  163.     regs.ch := $00;                                         { back to track 0 for next test }
  164.     regs.cl := $01;                                         { sector bit for XTs            }
  165.     regs.dh := 0;
  166.     regs.dl := $80 + disk;
  167.     intr($13,regs);                                         { seek }
  168.  
  169.     if ( (regs.flags and Fcarry) <> 0) then disk_err(regs.ah);
  170.  
  171.     for indx := 1 to maxcyl do                              { from track 0, seek to all tracks }
  172.     begin
  173.         regs.ah := $0C;
  174.         regs.ch := indx and $00FF;                          { mask tracks bits and stuff in cl & ch }
  175.         regs.cl := ((indx and $0300) shr 2) + 1;            { cl sector bit 1 for XTs               }
  176.         regs.dh := 0;
  177.         regs.dl := $80 + disk;
  178.  
  179.         t_entry(2);
  180.         intr($13,regs);                                     { seek }
  181.         t_exit(2);
  182.  
  183.         if ( (regs.flags and Fcarry) <> 0) then disk_err(regs.ah);
  184.  
  185.         if ((indx mod 100) = 0) then write(indx,' ');       { echo to user our progress }
  186.  
  187.         regs.ah := $0C;
  188.         regs.ch := $00;                                     { go back to track 0 for next seek }
  189.         regs.cl := $01;
  190.         regs.dh := 0;
  191.         regs.dl := $80 + disk;
  192.         intr($13,regs);
  193.  
  194.         if ( (regs.flags and Fcarry) <> 0) then disk_err(regs.ah);
  195.  
  196.     end;
  197.  
  198.     t_ask_timer(1,hits1,seek1);                             { query timers }
  199.     t_ask_timer(2,hits2,seek2);
  200.     t_ask_timer(3,hits3,seek3);
  201.  
  202.     writeln;
  203.     writeln;
  204.     writeln('Test of physical disk ',disk,' complete.');
  205.     writeln('Average track to track seek ........... ',((seek1/hits1)/1000.0):7:3,' milliseconds');
  206.     writeln('Average seek to all tracks ............ ',((seek2/hits2)/1000.0):7:3,' milliseconds');
  207.     writeln('Estimated software overhead per seek .. ',((seek3/hits3)/1000.0):7:3,' milliseconds');
  208.  
  209.     t_reset(1);                                             { reset all timers }
  210.     t_reset(2);
  211.     t_reset(3);
  212.  
  213. end; { test_disk }
  214.  
  215.  
  216. begin
  217.  
  218.     t_start;                                                { start TPHRT }
  219.  
  220.     writeln('SeekTest V1.00.  TPHRT V2.00 Demonstration Series');
  221.     writeln('(c)1989 Ryle Design, P.O. Box 22, Mt. Pleasant, Michigan 48804');
  222.     writeln;
  223.     write('Checking equipment ... ');
  224.  
  225.     regs.ah := $08;
  226.     regs.dl := $80;
  227.     intr($13,regs);                                         { get available physical disks }
  228.  
  229.     if ( (regs.flags and Fcarry) <> 0) then
  230.     begin
  231.         writeln('There are no hard disks on this system!');
  232.         writeln('SeekTest complete');
  233.         halt;
  234.     end;
  235.  
  236.     numdisk := regs.dl;                                     { DL has total disks on controller }
  237.     writeln(numdisk,' physical hard disk(s) found');
  238.     writeln;
  239.     writeln('*** WARNING -- Do not proceed unless the test disk is backed up!');     { A word of advice ... }
  240.     repeat
  241.         writeln;
  242.         for indx := 0 to (numdisk-1) do writeln(indx,' ... Test disk ',indx);
  243.         writeln(numdisk,' ... Exit SeekTest');
  244.         repeat
  245.             write('Select disk or exit (0-',numdisk,') >> ');
  246.             readln(atom);
  247.         until ( (atom >= 0) and (atom <= numdisk) );
  248.  
  249.         if (atom = numdisk) then
  250.         begin
  251.             t_stop;                                         { shut down TPHRT before exit }
  252.             writeln('SeekTest complete');
  253.             halt;
  254.         end;
  255.  
  256.         test_disk(atom);
  257.  
  258.     until (atom = numdisk);
  259.  
  260. end.  { seektest }
  261.